VERSION 5.00
Begin VB.UserControl TextBox 
   ClientHeight    =   1020
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1695
   PropertyPages   =   "TextBox.ctx":0000
   ScaleHeight     =   1020
   ScaleWidth      =   1695
   ToolboxBitmap   =   "TextBox.ctx":0023
   Begin VB.TextBox txtText 
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'None
      ForeColor       =   &H00000000&
      Height          =   375
      Left            =   60
      TabIndex        =   1
      Text            =   "TextBox"
      Top             =   240
      Width           =   1575
   End
   Begin VB.Label lblHeader 
      Alignment       =   2  'Center
      Caption         =   "Header"
      ForeColor       =   &H00000000&
      Height          =   255
      Left            =   0
      TabIndex        =   2
      Top             =   720
      Visible         =   0   'False
      Width           =   1575
   End
   Begin VB.Label lblText 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "TextBox"
      ForeColor       =   &H00000000&
      Height          =   375
      Left            =   60
      TabIndex        =   0
      Top             =   30
      Visible         =   0   'False
      Width           =   1575
   End
   Begin VB.Shape shpBorder 
      BackColor       =   &H00FFFFFF&
      BackStyle       =   1  'Opaque
      BorderColor     =   &H00808080&
      Height          =   615
      Left            =   0
      Top             =   0
      Width           =   1695
   End
End
Attribute VB_Name = "TextBox"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'Protected enum
Enum TxtAlign
    [aTop]
    [aCenter]
    [aBottom]
End Enum

'Properties variables
Dim ctlNumberBox           As Boolean
Dim ctlVAlign              As Byte
Dim ctlBorder              As Boolean
Dim ctlSelOnFocus          As Boolean

'Private variables
Private m_BackColor        As OLE_COLOR
Private m_BorderColor      As OLE_COLOR
Private m_BorderColorFocus As OLE_COLOR

'Events declaration
Event Click()
Event DblClick()
Event Change()
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event KeyDown(KeyCode As Integer, Shift As Integer)
Event KeyPress(KeyAscii As Integer)
Event KeyUp(KeyCode As Integer, Shift As Integer)

' *********************************************************************************
' PROPERTIES
' *********************************************************************************

Public Property Get AlignHorizontal() As AlignmentConstants
    AlignHorizontal = txtText.Alignment
End Property

Public Property Let AlignHorizontal(ByVal New_Value As AlignmentConstants)

    If New_Value > 2 Then New_Value = 2
    txtText.Alignment = New_Value
    lblText.Alignment = New_Value
    PropertyChanged "AlignHorizontal"
End Property

Public Property Get AlignVertical() As TxtAlign
    AlignVertical = ctlVAlign
End Property

Public Property Let AlignVertical(ByVal New_Value As TxtAlign)
    ctlVAlign = New_Value
    SetAlign ctlVAlign
    PropertyChanged "AlignVertical"
End Property

Public Property Get BackColor() As OLE_COLOR
    BackColor = shpBorder.BackColor
End Property

Public Property Let BackColor(ByVal New_Color As OLE_COLOR)
    m_BackColor = New_Color
    shpBorder.BackColor = New_Color
    txtText.BackColor = New_Color
    PropertyChanged "BackColor"
End Property

Public Property Get Border() As Boolean
    Border = ctlBorder
End Property

Public Property Let Border(ByVal New_Value As Boolean)
    ctlBorder = New_Value
    shpBorder.BorderColor = IIf(ctlBorder, m_BorderColor, m_BackColor)
    PropertyChanged "Border"
End Property

Public Property Get BorderColor() As OLE_COLOR
    BorderColor = m_BorderColor
End Property

Public Property Let BorderColor(ByVal New_Color As OLE_COLOR)
    m_BorderColor = New_Color
    shpBorder.BorderColor = New_Color
    PropertyChanged "BorderColor"
End Property

Public Property Get BorderColorFocus() As OLE_COLOR
    BorderColorFocus = m_BorderColorFocus
End Property

Public Property Let BorderColorFocus(ByVal New_Color As OLE_COLOR)
    m_BorderColorFocus = New_Color
    PropertyChanged "BorderColorFocus"
End Property

Public Property Get Enabled() As Boolean
    Enabled = txtText.Enabled
End Property

Public Property Let Enabled(ByVal New_Value As Boolean)
    txtText.Enabled = New_Value
    lblText.Enabled = New_Value
    PropertyChanged "Enabled"
End Property

Public Property Get Font() As Font
    Set Font = txtText.Font
End Property

Public Property Set Font(ByRef New_Font As Font)
    Set txtText.Font = New_Font
    Set lblText.Font = New_Font
    SetAlign ctlVAlign
    PropertyChanged "Font"
End Property

Public Property Get ForeColor() As OLE_COLOR
    ForeColor = txtText.ForeColor
End Property

Public Property Let ForeColor(ByVal New_Color As OLE_COLOR)
    txtText.ForeColor = New_Color
    lblText.ForeColor = New_Color
    PropertyChanged "ForeColor"
End Property

Public Property Get Header() As Boolean
    Header = lblHeader.Visible
End Property

Public Property Let Header(ByVal New_Value As Boolean)
    lblHeader.Visible = New_Value
    SetAlign ctlVAlign
    PropertyChanged "Header"
End Property

Public Property Get HeaderAlign() As AlignmentConstants
    HeaderAlign = lblHeader.Alignment
End Property

Public Property Let HeaderAlign(ByVal New_Value As AlignmentConstants)

    If New_Value > 2 Then New_Value = 2
    lblHeader.Alignment = New_Value
    PropertyChanged "HeaderAlign"
End Property

Public Property Get HeaderBackColor() As OLE_COLOR
    HeaderBackColor = lblHeader.BackColor
End Property

Public Property Let HeaderBackColor(ByVal New_Value As OLE_COLOR)
    lblHeader.BackColor = New_Value
    UserControl.BackColor = New_Value
    PropertyChanged "HeaderBackColor"
End Property

Public Property Get HeaderCaption() As String
    HeaderCaption = lblHeader.Caption
End Property

Public Property Let HeaderCaption(ByVal New_Value As String)
    lblHeader.Caption = New_Value
    PropertyChanged "HeaderCaption"
End Property

Public Property Get HeaderFont() As Font
    Set HeaderFont = lblHeader.Font
End Property

Public Property Set HeaderFont(ByRef New_Font As Font)
    Set lblHeader.Font = New_Font
    SetAlign ctlVAlign
    PropertyChanged "HeaderFont"
End Property

Public Property Get HeaderForeColor() As OLE_COLOR
    HeaderForeColor = lblHeader.ForeColor
End Property

Public Property Let HeaderForeColor(ByVal New_Value As OLE_COLOR)
    lblHeader.ForeColor = New_Value
    PropertyChanged "HeaderForeColor"
End Property

Public Property Get LabelBox() As Boolean
    LabelBox = lblText.Visible
End Property

Public Property Let LabelBox(ByVal New_Value As Boolean)
    lblText.Visible = New_Value
    txtText.Visible = Not New_Value
    PropertyChanged "LabelBox"
End Property

Public Property Get Locked() As Boolean
    Locked = txtText.Locked
End Property

Public Property Let Locked(ByVal New_Value As Boolean)
    txtText.Locked = New_Value
    PropertyChanged "Locked"
End Property

Public Property Get MaxLength() As Integer
    MaxLength = txtText.MaxLength
End Property

Public Property Let MaxLength(ByVal New_Value As Integer)

    If New_Value < 0 Then New_Value = 0
    txtText.MaxLength = New_Value
    PropertyChanged "MaxLength"
End Property

Public Property Get MouseIcon() As Picture
    Set MouseIcon = txtText.MouseIcon
End Property

Public Property Set MouseIcon(ByVal New_MouseIcon As Picture)
    Set txtText.MouseIcon = New_MouseIcon
    PropertyChanged "MouseIcon"
End Property

Public Property Get MousePointer() As MousePointerConstants
    MousePointer = txtText.MousePointer
End Property

Public Property Let MousePointer(ByVal New_MousePointer As MousePointerConstants)

    If New_MousePointer < vbDefault Then New_MousePointer = vbDefault
    If (New_MousePointer > vbSizeAll) And (New_MousePointer <> vbCustom) Then New_MousePointer = vbSizeAll
    txtText.MousePointer() = New_MousePointer
    PropertyChanged "MousePointer"
End Property

Public Property Get NumberBox() As Boolean
    NumberBox = ctlNumberBox
End Property

Public Property Let NumberBox(ByVal New_Value As Boolean)
    ctlNumberBox = New_Value
    PropertyChanged "NumberBox"
End Property

Public Property Get PasswordChar() As String
    PasswordChar = txtText.PasswordChar
End Property

Public Property Let PasswordChar(ByVal New_Value As String)

    If Len(New_Value) > 1 Then New_Value = Left$(New_Value, 1)
    txtText.PasswordChar = New_Value
    PropertyChanged "PasswordChar"
End Property

Public Property Get SelOnFocus() As Boolean
    SelOnFocus = ctlSelOnFocus
End Property

Public Property Let SelOnFocus(ByVal New_Value As Boolean)
    ctlSelOnFocus = New_Value
    PropertyChanged "SelOnFocus"
End Property

Public Property Get Text() As String
    Text = txtText.Text
End Property

Public Property Let Text(ByVal New_Value As String)
    txtText.Text = New_Value
    lblText.Caption = New_Value
    PropertyChanged "Text"
End Property

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    txtText.Alignment = PropBag.ReadProperty("AlignHorizontal", 0)
    lblText.Alignment = txtText.Alignment
    ctlVAlign = PropBag.ReadProperty("AlignVertical", 1)
    SetAlign ctlVAlign
    BackColor = PropBag.ReadProperty("BackColor", vbWhite)
    shpBorder.BackColor = PropBag.ReadProperty("BackColor", vbWhite)
    txtText.BackColor = shpBorder.BackColor
    lblText.BackColor = shpBorder.BackColor
    Border = PropBag.ReadProperty("Border", True)
    BorderColor = PropBag.ReadProperty("BorderColor", &HE6DDDB)
    BorderColorFocus = PropBag.ReadProperty("BorderColorFocus", &HFF9933)
    txtText.Enabled = PropBag.ReadProperty("Enabled", True)
    lblText.Enabled = txtText.Enabled
    Set txtText.Font = PropBag.ReadProperty("Font", Ambient.Font)
    Set lblText.Font = txtText.Font
    txtText.ForeColor = PropBag.ReadProperty("ForeColor", vbBlack)
    lblText.ForeColor = txtText.ForeColor
    lblHeader.Visible = PropBag.ReadProperty("Header", False)
    lblHeader.Alignment = PropBag.ReadProperty("HeaderAlign", 0)
    lblHeader.BackColor = PropBag.ReadProperty("HeaderBackColor", &HF5F5F5)
    UserControl.BackColor = lblHeader.BackColor
    lblHeader.Caption = PropBag.ReadProperty("HeaderCaption", "Header")
    Set lblHeader.Font = PropBag.ReadProperty("HeaderFont", Ambient.Font)
    lblHeader.ForeColor = PropBag.ReadProperty("HeaderForeColor", vbBlack)
    lblText.Visible = PropBag.ReadProperty("LabelBox", False)
    txtText.Visible = Not lblText.Visible
    txtText.Locked = PropBag.ReadProperty("Locked", False)
    txtText.MaxLength = PropBag.ReadProperty("MaxLength", 0)
    Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
    txtText.MousePointer = PropBag.ReadProperty("MousePointer", vbDefault)
    ctlNumberBox = PropBag.ReadProperty("NumberBox", False)
    txtText.PasswordChar = PropBag.ReadProperty("PasswordChar", "")
    ctlSelOnFocus = PropBag.ReadProperty("SelOnFocus", False)
    txtText.Text = PropBag.ReadProperty("Text", Ambient.DisplayName)
    lblText.Caption = txtText.Text
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("AlignHorizontal", txtText.Alignment, 0)
    Call PropBag.WriteProperty("AlignVertical", ctlVAlign, 1)
    Call PropBag.WriteProperty("BackColor", shpBorder.BackColor, vbWhite)
    Call PropBag.WriteProperty("Border", ctlBorder, True)
    Call PropBag.WriteProperty("BorderColor", m_BorderColor, &HE6DDDB)
    Call PropBag.WriteProperty("BorderColorFocus", m_BorderColorFocus, &HFF9933)
    Call PropBag.WriteProperty("Enabled", txtText.Enabled, True)
    Call PropBag.WriteProperty("Font", txtText.Font, Ambient.Font)
    Call PropBag.WriteProperty("ForeColor", txtText.ForeColor, vbBlack)
    Call PropBag.WriteProperty("Header", lblHeader.Visible, False)
    Call PropBag.WriteProperty("HeaderAlign", lblHeader.Alignment, 0)
    Call PropBag.WriteProperty("HeaderBackColor", lblHeader.BackColor, &HF5F5F5)
    Call PropBag.WriteProperty("HeaderCaption", lblHeader.Caption, "Header")
    Call PropBag.WriteProperty("HeaderFont", lblHeader.Font, Ambient.Font)
    Call PropBag.WriteProperty("HeaderForeColor", lblHeader.ForeColor, vbBlack)
    Call PropBag.WriteProperty("LabelBox", lblText.Visible, False)
    Call PropBag.WriteProperty("Locked", txtText.Locked, False)
    Call PropBag.WriteProperty("MaxLength", txtText.MaxLength, 0)
    Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing)
    Call PropBag.WriteProperty("MousePointer", txtText.MousePointer, vbDefault)
    Call PropBag.WriteProperty("NumberBox", ctlNumberBox, False)
    Call PropBag.WriteProperty("PasswordChar", txtText.PasswordChar, "")
    Call PropBag.WriteProperty("SelOnFocus", ctlSelOnFocus, False)
    Call PropBag.WriteProperty("Text", txtText.Text, Ambient.DisplayName)
End Sub

' *********************************************************************************
' EVENTS
' *********************************************************************************

Private Sub txtText_Click()
    RaiseEvent Click
End Sub

Private Sub txtText_DblClick()
    RaiseEvent DblClick
End Sub

Private Sub txtText_Change()
    lblText.Caption = txtText.Text
    RaiseEvent Change
End Sub

Private Sub txtText_GotFocus()

    ' If the property SelOnFocus has been selected, then all text is selected
    If ctlSelOnFocus Then
        txtText.SelStart = 0
        txtText.SelLength = Len(txtText)
    End If
    shpBorder.BorderColor = IIf(ctlBorder, m_BorderColorFocus, m_BackColor)
End Sub

Private Sub txtText_LostFocus()
    shpBorder.BorderColor = IIf(ctlBorder, m_BorderColor, m_BackColor)
End Sub

Private Sub txtText_MouseDown(Button As Integer, _
                              Shift As Integer, _
                              X As Single, _
                              Y As Single)
    RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Private Sub txtText_MouseMove(Button As Integer, _
                              Shift As Integer, _
                              X As Single, _
                              Y As Single)
    RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub txtText_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Private Sub txtText_KeyDown(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub txtText_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)

    ' If the property NumberBox has been selected, then only numbers can be typed
    If ctlNumberBox Then
        If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then KeyAscii = 0
    End If
End Sub

Private Sub txtText_KeyUp(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyUp(KeyCode, Shift)
End Sub

' *********************************************************************************
' FUNCTION
' *********************************************************************************

Public Property Get hwnd() As Long
    hwnd = UserControl.hwnd
End Property

Public Sub Refresh()
    txtText.Refresh
    lblText.Refresh
    UserControl.Refresh
End Sub

' *********************************************************************************
' USER CONTROL
' *********************************************************************************

Private Sub UserControl_Show()
    shpBorder.BorderColor = IIf(ctlBorder, m_BorderColor, m_BackColor)
End Sub

Private Sub UserControl_InitProperties()
    txtText.Alignment = 0
    lblText.Alignment = 0
    ctlVAlign = 1
    BackColor = vbWhite
    shpBorder.BackColor = vbWhite
    txtText.BackColor = vbWhite
    lblText.BackColor = vbWhite
    Border = True
    BorderColor = &HE6DDDB
    shpBorder.BorderColor = &HE6DDDB
    BorderColorFocus = &HFF9933
    txtText.Enabled = True
    lblText.Enabled = True
    Set txtText.Font = Ambient.Font
    Set lblText.Font = Ambient.Font
    txtText.ForeColor = vbBlack
    lblText.ForeColor = vbBlack
    txtText.Visible = True
    lblText.Visible = False
    lblHeader.Alignment = 0
    lblHeader.Visible = False
    lblHeader.BackColor = &HF5F5F5
    UserControl.BackColor = vbWhite
    lblHeader.Caption = "Header"
    Set lblHeader.Font = Ambient.Font
    txtText.Locked = False
    txtText.MaxLength = 0
    ctlNumberBox = False
    txtText.PasswordChar = ""
    ctlSelOnFocus = False
    txtText.Text = Ambient.DisplayName
    lblText.Caption = Ambient.DisplayName
End Sub

' Resize text, label, header and border to the control size
Private Sub UserControl_Resize()
    On Error Resume Next

    If UserControl.Width < 255 Then UserControl.Width = 255
    If UserControl.Height < 255 Then UserControl.Height = 255
    shpBorder.Width = UserControl.Width
    txtText.Width = shpBorder.Width - 120
    SetAlign ctlVAlign
End Sub

' *********************************************************************************
' CUSTOM ROUTINES
' *********************************************************************************

' This routine is used to align the controls
Private Sub SetAlign(ByVal Value As Byte)
    Dim YOffSet As Integer
    
    lblHeader.AutoSize = True   ' Automatically gets the header minimum height
    lblHeader.AutoSize = False

    If lblHeader.Visible Then   ' If the header is visible, all other things get shifted down
        YOffSet = lblHeader.Height + 15
    Else
        YOffSet = 0
    End If
    
    lblHeader.Left = 0          ' Ensure that the header is positioned in the left side
    lblHeader.Top = 0           ' Ensure that the header is positioned in the top side
    lblHeader.Width = shpBorder.Width
    shpBorder.Top = YOffSet
    shpBorder.Height = UserControl.Height - IIf(lblHeader.Visible, YOffSet, 0)
    lblText.AutoSize = True         ' It automatically gets the label minimum height
    lblText.AutoSize = False
    
    Select Case Value

        Case 0                  ' TOP
            txtText.Top = 15 + shpBorder.Top
            lblText.Top = 15 + shpBorder.Top

        Case 1                  ' CENTER
            lblText.Top = shpBorder.Top + ((shpBorder.Height - lblText.Height) / 2)
            txtText.Top = lblText.Top

        Case 2                  ' BOTTOM
            lblText.Top = shpBorder.Top + (shpBorder.Height - lblText.Height) - 15
            txtText.Top = lblText.Top
    End Select
    
    lblText.Width = txtText.Width       ' Readjust the width
    lblText.Left = txtText.Left         ' Readjust the position
    txtText.Height = 0              ' Automatically gets the text minimum height
End Sub
